1，新建一个空工作簿，保留一个表，取名叫：汇总，保存该工作簿，随便取名，但是保存类型必须选择为“Excel启用宏的工作簿”。如果你是2003的excel版本，那就默认

2007及2010等版本的保存截图：

2003版本保存类型截图：

2，上面保存的工作簿，请保存在和那些要被合并的工作簿一个文件夹下

3，需要注意的是那些要被合并的工作簿里可能有若干个工作表，数量不等，每个表的行数也不等，但是每个工作簿每个工作表的列数一样，列的顺序一样，列的字段名字一样。

下面是其中一个要被合并的工作簿的截图：

4，打开那个空白工作表的工作簿，alt F11进入vba代码编辑器，插入，模块，双击模块1

5，把下面这段代码粘贴到模块1里去

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & '\' & '*.xlsx')

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName ''

If MyName AWbName Then

Set Wb = Workbooks.Open(MyPath & '\' & MyName)

Num = Num 1

With Workbooks(AWbName).ActiveSheet

.Cells(.Range('A65536').End(xlUp).Row, 1).Offset(-(Num 1), 0) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range('A65536').End(xlUp).Row 1, 1)

Next

WbN = WbN & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MyName = Dir

Loop

Range('A1').Select

Application.ScreenUpdating = True

MsgBox '共合并了' & Num & '个工作薄下的全部工作表。如下：' & Chr(13) & WbN, vbInformation, '提示'

End Sub

6，然后关闭vba编辑器，再alt F8调出宏，选中刚复制的那个宏，执行

大约10秒就会出来结果

-----------------------------------------------------------

看完后觉得好，请不吝您的评价，点赞！！！你的点赞是我的动力！

赠人玫瑰之手，经久犹有余香。

The roses in her hand,the flavor in mine.

---------------------------------------------------